home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
VISUALBA
/
DFVB10.ZIP
/
DFDEMO.BAS
next >
Wrap
BASIC Source File
|
1993-01-06
|
12KB
|
347 lines
DEFINT A-Z
' $INCLUDE: '\inc\dframevb.inc' 'change path if need be
' $INCLUDE: '\inc\ownervb.inc' 'contains my serial #. Delete this
'line if necessary.
ProgName$ = "DoorFrame Demo"
ExeName$ = "DFDEMO"
Version$ = " 1.0"
INITIALIZE
CLOSE #1
DETECT.ANSI 'Make sure the caller is ANSI capable!
ON ERROR GOTO Err.Routine
SysopKeys% = 1 'Use alternate set so we can use the arrows
DIM Menu$(8) 'Holds our Menu entries
'Since this demo uses cursor positioning, the caller must be ANSI compatible.
'Kick him out if he isn't.
IF Graphics% = 0 THEN
ClrScrn Black
DIS.PLAY "This Door requires ANSI.SYS compatibility!", LWHITE, Black, 0, 0, 1, 1, 1, 0, 0
DIS.PLAY "Returning you to the BBS", LWHITE, Black, 0, 0, 2, 1, 1, 0, 0
DE.LAY 3
EXIT.DOOR "Y"
END IF
'Also needs color to see the demo. If not in color mode, ask to switch.
PriorMode% = Mode% 'Save current color mode
IF Mode% = 0 THEN 'Does he have color on?
DIS.PLAY "You will need to be in Color Mode to see this demo.", LWHITE, Black, 0, 1, 10, 1, 1, 1, 0
DIS.PLAY "Type Y to switch to Color or N to return to BBS [Y/n] > ", LWHITE, Black, 0, 0, 12, 1, 0, 1, 0
IF UCASE$(Response$) <> "N" THEN
Mode% = -1 'Turn color on
ELSE
EXIT.DOOR "Y"
END IF
END IF
Menu$(1) = "}B}ox.It Demo"
Menu$(2) = "Clr}E}ol Demo"
Menu$(3) = "}C}lrScrn Demo"
Menu$(4) = "}D}is.Play Demo"
Menu$(5) = "}I}n.Put Demo"
Menu$(6) = "Make.Blt Dem}O}" 'Can't use M when SysopKeys% = 1
Menu$(7) = "}S}end Demo"
Menu$(8) = "}G}et me out!"
Start:
MenuPos% = 1 'Where are we on the Menu?
ClrScrn BLUE 'Clear the screen with a BLUE background
'Draw a box for our menu
BOX.IT 5, 30, 16, 50, 2, LWHITE, CYAN, LWHITE, CYAN, 32, 0, "Menu", 0, 7
'Write the menu and highlight bar
FOR x = 1 TO 8
DIS.PLAY Menu$(x), Black, CYAN, 0, 0, x + 6, 33, 1, 0, 0
NEXT
DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
'Qmodem redefines the arrow keys. Any feedback on other term programs?
DIS.PLAY "If you are using Qmodem, switch to DoorWay mode to use the arrows.", LWHITE, BLUE, 0, 0, 22, 1, 1, 1, 0
GetInput:
'Prompt for a choice. Get a 1-key response and act on it
IN.PUT 1, 0, LCYAN, BLUE, 1, "Your Choice? ", 19, 34, 1
SELECT CASE UCASE$(Response$) 'Response$ holds the callers input.
CASE "B"
GOSUB BoxDemo
CASE "E"
GOSUB EolDemo
CASE "C"
GOSUB ClrDemo
CASE "D"
GOSUB DisplayDemo
CASE "I"
GOSUB InputDemo
CASE "O"
GOSUB BltDemo
CASE "S"
GOSUB SendDemo
CASE "G"
GOTO GoodBye
CASE "UP" 'Returned in Response$ when using alternate Sysop
'keys and the UP Arrow or capital H is pressed.
DIS.PLAY Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
IF MenuPos% = 1 THEN
MenuPos% = 8
ELSE
MenuPos% = MenuPos% - 1
END IF
DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
GOTO GetInput
CASE "DOWN"
DIS.PLAY Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
IF MenuPos% = 8 THEN
MenuPos% = 1
ELSE
MenuPos% = MenuPos% + 1
END IF
DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
GOTO GetInput
CASE ""
ON MenuPos% GOSUB BoxDemo, EolDemo, ClrDemo, DisplayDemo, InputDemo, BltDemo, SendDemo, GoodBye
CASE ELSE
'Display boo-boo message with a bell and wait 4 seconds
DIS.PLAY "Invalid selection!", LRED, BLUE, 0, 1, 19, 32, 0, 0, 0
DE.LAY 4
CLREOL 19, 32, BLUE 'Clear the message off
GOTO GetInput
END SELECT
GOTO Start 'Back to the Menu
BoxDemo: 'Box.It and Lines demo
'10x15 Box with no borders, shadow or title
ClrScrn WHITE
BOX.IT 2, 2, 11, 16, 0, LWHITE, BLUE, LCYAN, BLUE, 32, 0, "", 0, 0
'Tell 'em what it is
DIS.PLAY "10x15 Box", LWHITE, BLUE, 0, 0, 3, 4, 0, 0, 0
DIS.PLAY "No Border", LWHITE, BLUE, 0, 0, 5, 4, 0, 0, 0
DIS.PLAY "No Title", LWHITE, BLUE, 0, 0, 7, 4, 0, 0, 0
DIS.PLAY "No Shadow", LWHITE, BLUE, 0, 0, 9, 4, 0, 0, 0
'With border
BOX.IT 2, 21, 11, 36, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 0, "", 0, 0
DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 24, 0, 0, 0
DIS.PLAY "With border", LWHITE, BLUE, 0, 0, 7, 24, 0, 0, 0
'Add a shadow
BOX.IT 2, 41, 11, 56, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "", 0, 0
DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 44, 0, 0, 0
DIS.PLAY "With shadow", LWHITE, BLUE, 0, 0, 7, 44, 0, 0, 0
'Add a title
BOX.IT 2, 61, 11, 76, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "Title Demo", LCYAN, RED
DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 64, 0, 0, 0
DIS.PLAY "With title", LWHITE, BLUE, 0, 0, 7, 64, 0, 0, 0
'Now add some lines
DIS.PLAY "Now let's add some lines to the boxes", LRED, WHITE, 1, 0, 13, 1, 0, 1, 0
'Pause for effect
DE.LAY 2
LINES 4, 2, 15, "H", 0, 2, LWHITE, BLUE, LWHITE, BLUE
LINES 6, 2, 15, "H", 0, 1, LWHITE, BLUE, LWHITE, BLUE
LINES 8, 2, 15, "H", 0, 2, LWHITE, BLUE, LWHITE, BLUE
DE.LAY 2
LINES 4, 21, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
LINES 6, 21, 16, "H", 2, 1, LWHITE, BLUE, LWHITE, BLUE
LINES 8, 21, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
DE.LAY 2
LINES 4, 41, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
LINES 6, 41, 16, "H", 2, 1, LWHITE, BLUE, LWHITE, BLUE
LINES 8, 41, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
LINES 2, 48, 10, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
CLREOL 13, 1, WHITE
DIS.PLAY "How about some multi-colored boxes!!", Black, WHITE, 0, 0, 13, 1, 0, 1, 0
DE.LAY 4
'Draw a big box
BOX.IT 15, 2, 20, 77, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "Title Demo", LCYAN, RED
'Divide it in 3 parts
LINES 15, 27, 6, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
LINES 15, 52, 6, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
'Color in 2 of them
BOX.IT 16, 28, 19, 51, 0, LWHITE, GREEN, LCYAN, GREEN, 32, 0, "", 0, 0
BOX.IT 16, 53, 19, 76, 0, LWHITE, RED, LCYAN, RED, 32, 0, "", 0, 0
ENTER
RETURN
EolDemo: 'ClrEol demo
ClrScrn Black
DIS.PLAY "ClrEol Demo", LWHITE, Black, 0, 0, 1, 1, 0, 1, 0
' Clear 8 lines using each of the background colors
FOR x = 1 TO 7
CLREOL x + 3, 1, x
NEXT
DIS.PLAY "Clears from specified row/column to the End of Line in 8 Background colors", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0
'Do it again but put 2 different colors on each line
FOR x = 1 TO 7
CLREOL x + 12, 1, x
IF x < 4 THEN
CLREOL x + 12, 41, x + 4
ELSE
CLREOL x + 12, 41, x - 3
END IF
NEXT
DIS.PLAY "Multiple use results in lines with 2 or more colors", LWHITE, Black, 0, 0, 20, 1, 1, 1, 0
ENTER
RETURN
ClrDemo: 'ClrScrn demo
'Clear the screen using the 8 available background colors
FOR x = 0 TO 7
ClrScrn x
IF x = 7 THEN
'7 = White so change foreground to Black
DIS.PLAY "ClrScrn Demo using background color" + STR$(x), Black, x, 0, 0, 11, 1, 0, 1, 0
ELSE
DIS.PLAY "ClrScrn Demo using background color" + STR$(x), LWHITE, x, 0, 0, 11, 1, 0, 1, 0
END IF
DE.LAY 4
NEXT
ENTER
RETURN
DisplayDemo: 'Dis.Play demo
'Demonstrate various ways of using the Dis.Play statement
ClrScrn Black
DIS.PLAY "To demonstrate the Upper/Lower Case, please type a few words with mixed case", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0
IN.PUT 70, 0, LCYAN, Black, 1, "> ", 12, 1, 1
IF Response$ = "" OR Response$ < "A" THEN
CLREOL 11, 1, 0
CLREOL 12, 1, 0
DIS.PLAY "Ok, fine!", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0
ELSE
CLREOL 11, 1, 0
CLREOL 12, 1, 0
DIS.PLAY "Your response in lower case.", LWHITE, Black, 0, 0, 9, 1, 1, 1, 0
DIS.PLAY Response$, LWHITE, Black, 0, 0, 11, 1, 1, 1, -1
DE.LAY 4
CLREOL 9, 1, 0
CLREOL 11, 1, 0
DIS.PLAY "Your response in upper case.", LWHITE, Black, 0, 0, 9, 1, 1, 1, 0
DIS.PLAY Response$, LWHITE, Black, 0, 0, 11, 1